home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / dskut / movewipe.zip / MOVEWIPE.PAS < prev   
Pascal/Delphi Source File  |  1986-10-05  |  21KB  |  1,037 lines
  1. {╔════════════════════════════════════════════════════════════════════════╗
  2.  ║    MOVE.COM   by   Lawrence Spiwak       08/19/86                      ║
  3.  ║                                                                        ║
  4.  ╚════════════════════════════════════════════════════════════════════════╝}
  5.  
  6. program Move_File_Across_Subdirs;
  7.  
  8. const
  9.    BufSize     = 20000;
  10.  
  11. type
  12.    String2     = string[2];
  13.    String4     = string[4];
  14.    String255   = string[255];
  15.    RegType     = record ax,bx,cx,dx,bp,si,di,ds,es,flags : integer end;
  16.  
  17. var
  18.    NextFile      : boolean;
  19.    InputFile     : string[12];
  20.    OutputFile    : string[12];
  21.    InPath        : string[243];
  22.    OutPath       : string[243];
  23.    File1         : string[255];
  24.    File2         : string[255];
  25.    FileIn        : file;
  26.    FileOut       : file;
  27.    Handle1       : integer;
  28.    Handle2       : integer;
  29.    Attribute     : integer;
  30.    Names         : array[1..600] of string[12];
  31.    DataBlock     : array [1..BufSize] of byte;
  32.    CompBlock     : array [1..BufSize] of byte;
  33.    ErrorA        : byte;
  34.    I,J,K         : integer;
  35.    BlocksRead    : integer;
  36.    PutUp         : string[37];
  37.    Address1      : string[37];
  38.    Address2      : string[19];
  39.    OKToProceed   : boolean;
  40.    Regs          : RegType;
  41.    Bytes1        : integer;
  42.    Bytes2        : byte;
  43.    Bytes3        : integer;
  44.    Bytes4        : byte;
  45.    Buffer        : string[127];
  46.    CmdLine       : string[127] absolute cseg:$80;
  47.    Sort          : boolean;
  48.    Retry         : boolean;
  49.  
  50.  
  51.  
  52.  
  53.  
  54. procedure Convert_Cases(var InputString : String255);
  55.  
  56. var
  57.    Temp   : char;
  58.    A,B    : integer;
  59.  
  60. begin
  61.  
  62. B:=length(InputString);
  63. for A:=1 to B do begin
  64.    Temp:=InputString[A];
  65.    InputString[A]:=UpCase(Temp);
  66.    end;
  67.  
  68. end;
  69.  
  70.  
  71.  
  72.  
  73.  
  74. procedure Translate;
  75.  
  76. var
  77.    Index  : integer;
  78.  
  79. begin
  80.  
  81. PutUp:='NNWDXHQD/BPL!azM`xqfmdd!Rqhx`lw0/01';
  82. Address1:='311FVmjufqthux!Amue$03/4';
  83. Address2:='Ndmaptsmf+!EM41:/2';
  84.  
  85. for Index:=1 to Length(PutUp) do
  86.    if Odd(Index) then
  87.       PutUp[Index]:=chr(ord(PutUp[Index])-1)
  88.    else
  89.       PutUp[Index]:=chr(ord(PutUp[Index])+1);
  90.  
  91. for Index:=1 to Length(Address1) do
  92.    if Odd(Index) then
  93.       Address1[Index]:=chr(ord(Address1[Index])-1)
  94.    else
  95.       Address1[Index]:=chr(ord(Address1[Index])+1);
  96.  
  97. for Index:=1 to Length(Address2) do
  98.    if Odd(Index) then
  99.       Address2[Index]:=chr(ord(Address2[Index])-1)
  100.    else
  101.       Address2[Index]:=chr(ord(Address2[Index])+1);
  102.  
  103. Writeln(PutUp);
  104. Writeln;
  105.  
  106. end;
  107.  
  108.  
  109.  
  110.  
  111.  
  112. function LegalFile(FileName : String255) : Boolean;
  113.  
  114. var
  115.    Legal : boolean;
  116.    A     : integer;
  117.  
  118. begin
  119.  
  120. Legal:=True;
  121. for A:=1 to length(Filename) do
  122.    if not(FileName[A] in ['A'..'Z','\','*','?','-','_','$','.',':','1'..'9']) then
  123.       Legal:=False;
  124. LegalFile:=Legal;
  125.  
  126. end;
  127.  
  128.  
  129.  
  130.  
  131.  
  132. procedure Get_Command_Line;
  133.  
  134. var
  135.    Temp        : char;
  136.    TempFile    : string[255];
  137.    A,B,C       : integer;
  138.  
  139. begin
  140.  
  141. Buffer:=CmdLine;
  142. {$V-} Convert_Cases(Buffer) {$V+};
  143.  
  144. A:=1;
  145. while (Buffer[1]=' ') and (A<(Length(Buffer)+1)) do begin
  146.    Buffer:=Copy(Buffer,2,Length(Buffer)-1);
  147.    A:=A+1;
  148.    end;
  149.  
  150. A:=1; B:=0;
  151. while (A<Length(Buffer)+1) and (B=0) do
  152.    if not (Buffer[A] in ['!'..'_']) then
  153.       B:=A
  154.    else
  155.       A:=A+1;
  156.  
  157. TempFile:=Copy(Buffer,1,B-1);
  158. if Length(TempFile)<1 then begin
  159.    Writeln;
  160.    Write('Specify: ');
  161.    TextColor(White);
  162.    Writeln('MOVEWIPE   source_file   destination_file   /S');
  163.    TextColor(Yellow);
  164.    Writeln;
  165.    Writeln('To move multiple files using wildcards, you must specify the destination path');
  166.    Writeln('only (or another wildcard).  For example:');
  167.    Writeln;
  168.    Writeln('       MOVEWIPE d1:dir1\dir2\filename.*  d2:dir3\dir4\*.*');
  169.    Writeln;
  170.    Writeln('Files selected with the wildcard cannot be moved to a single file.');
  171.    Writeln('Single files cannot be copied to wildcard files.  Files selected with');
  172.    Writeln('the wildcard cannot be renamed in the copying process.  However, single');
  173.    Writeln('files may be renamed by simply specifying a different destination name.');
  174.    Writeln('If the destination name is not found the current filename will be used.');
  175.    Writeln;
  176.    Writeln('An optional switch  "/S"  allows the user to sort the directory by filename.');
  177.    Writeln;
  178.    Writeln('If you find this program of use, please send $10 in contributions to:');
  179.    Writeln;
  180.    Writeln('                                ',copy(PutUp,17,15));
  181.    Writeln('                          ',Address1);
  182.    Writeln('                              ',Address2);
  183.    Halt;
  184.    end;
  185. C:=Length(Buffer)-B+1;
  186. Buffer:=Copy(Buffer,B,C);
  187. if not (Buffer[1]=' ') then begin
  188.    Writeln('Specify a Destination File');
  189.    Halt;
  190.    end
  191. else
  192.    Buffer:=Copy(Buffer,2,Length(Buffer)-1);
  193.  
  194. if not (LegalFile(TempFile)) then begin
  195.    Writeln('Illegal source filename');
  196.    Halt;
  197.    end;
  198.  
  199. B:=0;
  200. for A:=length(TempFile) downto 1 do
  201.    if (((TempFile[A]='\') or (TempFile[A]=':')) and (B=0)) then
  202.       B:=A;
  203.  
  204. if (B>0) then begin
  205.    A:=Length(TempFile);
  206.    InputFile:=Copy(TempFile,B+1,(A-B));
  207.    InPath:=Copy(TempFile,1,B);
  208.    if InputFile='' then begin
  209.       Writeln('Specify an Input File');
  210.       Halt;
  211.       end;
  212.    end
  213. else begin
  214.    InputFile:=TempFile;
  215.    InPath:=''
  216.    end;
  217.  
  218. if (Length(InPath)=2) and (InPath[2]=':') then begin
  219.    GetDir(Ord(InPath[1])-64,InPath);
  220.    if InPath[Length(InPath)]<>'\' then
  221.       InPath:=InPath+'\';
  222.       end
  223. else if InPath='' then begin
  224.    GetDir(0,InPath);
  225.    if InPath[Length(InPath)]<>'\' then
  226.       InPath:=InPath+'\';
  227.    end;
  228.  
  229. A:=1;
  230. while (Buffer[1]=' ') and (A<Length(Buffer)) do begin
  231.    Buffer:=Copy(Buffer,2,Length(Buffer)-1);
  232.    A:=A+1;
  233.    end;
  234.  
  235. A:=1; B:=0;
  236. while (A<128) and (B=0) do
  237.    if not (Buffer[A] in ['!'..'_']) then
  238.       B:=A
  239.    else
  240.       A:=A+1;
  241.  
  242. TempFile:=Copy(Buffer,1,B-1);
  243. Buffer:=Copy(Buffer,B,Length(Buffer)-Length(TempFile));
  244.  
  245. B:=Length(TempFile);
  246. if not (LegalFile(TempFile)) then begin
  247.    Writeln('Illegal destination filename');
  248.    Halt;
  249.    end;
  250.  
  251. B:=0;
  252. for A:=length(TempFile) downto 1 do
  253. if (((TempFile[A]='\') or (TempFile[A]=':')) and (B=0)) then B:=A;
  254. if (B>0) then begin
  255.    A:=Length(TempFile);
  256.    OutputFile:=Copy(TempFile,B+1,(A-B));
  257.    OutPath:=Copy(TempFile,1,B);
  258.    end
  259. else begin
  260.    OutputFile:=TempFile;
  261.    OutPath:='';
  262.    end;
  263.  
  264. if (Length(OutPath)=2) and (OutPath[2]=':') then begin
  265.    GetDir(Ord(OutPath[1])-64,OutPath);
  266.    if OutPath[Length(OutPath)]<>'\' then
  267.       OutPath:=OutPath+'\';
  268.       end
  269. else if OutPath='' then begin
  270.    GetDir(0,OutPath);
  271.    if OutPath[Length(OutPath)]<>'\' then
  272.       OutPath:=OutPath+'\';
  273.       end;
  274.  
  275. A:=1;
  276. while (Buffer[1]=' ') and (A<(Length(Buffer)+1)) do begin
  277.    Buffer:=Copy(Buffer,2,Length(Buffer)-1);
  278.    A:=A+1;
  279.    end;
  280.  
  281. end;
  282.  
  283.  
  284.  
  285.  
  286.  
  287. procedure Check_Input_File;
  288.  
  289. var
  290.    FileThere : boolean;
  291.    Index     : integer;
  292.    Temp      : integer;
  293.  
  294. begin
  295. with Regs do begin
  296.  
  297. File1:=InPath+InputFile+chr(0);
  298.  
  299. Index:=0;
  300. Attribute:=0;
  301. Temp:=1;
  302.  
  303. while (Attribute<>Temp) and (Index<5) do begin
  304.    ax:=$4300;  {Get attribute}
  305.    ds:=seg(File1);
  306.    dx:=ofs(File1)+1;
  307.    Intr($21,Regs);
  308.    Attribute:=cx;
  309.  
  310.    ax:=$4300;  {Get attribute again for safecheck.  Check up to 5 times}
  311.    ds:=seg(File1);
  312.    dx:=ofs(File1)+1;
  313.    Intr($21,Regs);
  314.    Temp:=cx;
  315.  
  316.    Index:=Index+1;
  317.    end;
  318.  
  319. if Attribute<>Temp then begin
  320.    TextColor(LightRed);
  321.    Writeln;
  322.    Writeln('Error reading attributes : Transient values returned.  Program aborted.');
  323.    Halt;
  324.    end;
  325.  
  326. ax:=$4301;   {Set attribute to null}
  327. cx:=$0000;
  328. ds:=seg(File1);
  329. dx:=ofs(File1)+1;
  330. Intr($21,Regs);
  331.  
  332. Assign(FileIn,InPath+InputFile);
  333. {$I-} Reset(FileIn) {I$+};
  334. FileThere:=(IOresult=0);
  335.  
  336. if FileThere then
  337.    Close(FileIn);
  338.  
  339. if not FileThere then begin
  340.    Writeln('File ',InPath,InputFile,' not found.');
  341.    Halt;
  342.    end;
  343.  
  344. end;
  345. end;
  346.  
  347.  
  348.  
  349.  
  350.  
  351. procedure Check_Output_File;
  352.  
  353. var
  354.    Temp      : char;
  355.    FileThere : boolean;
  356.    CheckFile : string[255];
  357.  
  358. begin
  359.  
  360. Temp:='Y';
  361. File2:=OutPath+OutputFile+chr(0);
  362.  
  363. Assign(FileIn,OutP